home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGSCAL / TURBOK50.LZH / SOURCE.ARC / READTTT5.PAS < prev    next >
Pascal/Delphi Source File  |  1989-06-02  |  36KB  |  1,116 lines
  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.01a                             }
  5. {                                                                          }
  6. {                                                                          }
  7. {              Copyright 1986, 1989 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}
  13.                      {       Unit:  ReadTTT5          }
  14.                      {--------------------------------}
  15.  
  16.  
  17. {History:         2/24/89   5.00a  Reversed return codes in ReadLine
  18.                   3/05/89   5.00b  Added Box proc to Read_Real
  19.                             5.01a  Added DEBUG compiler directive and added
  20.                                    mouse Enter/Esc support
  21. }
  22.  
  23. {$S-,R-,V-}
  24. {$IFNDEF DEBUG}
  25. {$D-}
  26. {$ENDIF}       
  27.  
  28. Unit ReadTTT5;
  29.  
  30. Interface
  31.  
  32. Uses CRT,FastTTT5,WinTTT5,StrnTTT5,KeyTTT5;
  33.  
  34. Type
  35.    R_Display = record
  36.                     WhiteSpace  : char;        {used to pad input field - default ··········} 
  37.                     AllowEsc    : boolean;     {allow the he user to escape?} 
  38.                     Beep        : Boolean;     {allow the old proverbial beep} 
  39.                     Insert      : boolean;     {initially in insert mode?} 
  40.                     BegCursor   : boolean;     {place cursor at beginning of line} 
  41.                     AllowNull   : boolean;     {allow user to input a '' or null value} 
  42.                     RightJustify: Boolean;     {right justify string on termination} 
  43.                     EraseDefault: Boolean;     {clear entry of alphanumeric pressed} 
  44.                     SuppressZero: Boolean;     {have empty field is value = zero}
  45.                     FCol        : byte;        {normal foreground color of input field}
  46.                     BCol        : byte;        {normal background of input field}
  47.                     HiFCol      : byte;        {highlighted fgnd color for Read_Select}
  48.                     HiBCol      : byte;        {highlighted bgnd color for Read_Select}
  49.                     LoFCol      : byte;        {normal fgnd color for Read_Select}
  50.                     LoBCol      : byte;        {normal bgnd color for Read_Select}
  51.                     PFcol       : byte;        {prompt foreground color}
  52.                     PBCol       : byte;        {prompt background color}
  53.                     BoxFCol     : byte;        {box foreground color}
  54.                     BoxBCol     : byte;        {Box background color}
  55.                     Msg_FCol    : byte;        {Foreground color for error messages}
  56.                     Msg_BCol    : byte;        {Background color for error messages}
  57.                     Msg_Line    : byte;        {line for error messages}
  58.                     End_chars   : set of char; {end of input chars}
  59.                     RealDP      : byte;        {no of decimal places on real}
  60.                end;
  61.  
  62. const
  63.     NoPrompt:string[1] = '';
  64. Var
  65.   RTTT : R_Display;
  66.   R_Char : char;
  67.   R_Null : boolean;
  68.  
  69. Procedure Default_Settings;
  70. Procedure ReadLine(X,Y,L,F,B:byte;var Text: string;var Retcode:integer);
  71. Procedure Read_String(X,Y,L:byte;
  72.                       Prompt:StrScreen; 
  73.                       BoxType: byte;
  74.                       Var Txt:StrScreen);
  75. Procedure Read_String_Upper(X,Y,L:byte;
  76.                             Prompt:StrScreen;
  77.                             BoxType: byte;
  78.                             Var Txt:StrScreen);
  79. Procedure Read_Password(X,Y,L:byte;
  80.                         Prompt:StrScreen;
  81.                         BoxType: byte;
  82.                         Var Txt:StrScreen);
  83. Procedure Read_Alpha(X,Y,L:byte;
  84.                      Prompt:StrScreen;
  85.                      BoxType: byte;
  86.                      Var Txt:StrScreen);
  87. Procedure Read_YN(X,Y:byte;
  88.                   Prompt:StrScreen;
  89.                   BoxType: byte;
  90.                   Var Yes:Boolean);
  91. Procedure Read_Byte(X,Y,L:byte; 
  92.                     Prompt:StrScreen;
  93.                     BoxType: byte;
  94.                     Var B : Byte;
  95.                     Min, Max : Byte);
  96. Procedure Read_Word(X,Y,L:byte; 
  97.                     Prompt:StrScreen;
  98.                     BoxType: byte;
  99.                     Var W : word;
  100.                     Min, Max : word);
  101. Procedure Read_Int(X,Y,L:byte;
  102.                    Prompt:StrScreen;
  103.                    BoxType: byte;
  104.                    Var W : integer;
  105.                    Min, Max : integer);
  106. Procedure Read_LongInt(X,Y,L:byte;
  107.                        Prompt:StrScreen;
  108.                        BoxType: byte;
  109.                        Var W : longint;
  110.                        Min, Max : longint);
  111. Procedure Read_Real(X,Y,L:byte;
  112.                     Prompt:StrScreen;
  113.                     BoxType: byte;
  114.                     Var W : real;
  115.                     Min, Max : real);
  116. Procedure Read_Select(X,Y:byte;Pmt,Txt:StrScreen;var Choice:byte);
  117. Implementation
  118.  
  119. CONST
  120.     PassChar    = #15;
  121.     CursorRight = #205;
  122.     CursorLeft  = #203;
  123.     CursorDown  = #208;
  124.     CursorUp    = #200;
  125.     EnterKey    = #13;
  126.     EscKey      = #27;
  127.     EndKey      = #207;
  128.     HomeKey     = #199;
  129.     DelKey      = #211;
  130.     Backspace   = #8;
  131.     InsKey      = #210;
  132.     Zap         = #160;      {Alt D to delete the field}
  133.     MinInt              = -32768;
  134.     MaxLongInt:longint  =  2147483647;
  135.     MinLongInt:longint  = -2147483647;
  136.     MaxWord             =  65535;
  137.     MinWord             =  0;
  138.     
  139. VAR
  140.    Cursor_X,
  141.    Cursor_Y,
  142.    ScanTop,
  143.    ScanBot   : byte;
  144.  
  145. Procedure Default_Settings;
  146. begin
  147.    with RTTT do
  148.    begin
  149.        WhiteSpace   := #250;
  150.        Beep         := true;
  151.        BegCursor    := false;
  152.        Insert       := false;
  153.        AllowEsc     := true;
  154.        AllowNull    := true;
  155.        RightJustify := false;
  156.        EraseDefault := false;
  157.        SuppressZero := true;
  158.        End_Chars := [#13,#133];  {Enter}
  159.        RealDP := 2;  
  160.        If BaseOfScreen = $B000 then
  161.        begin
  162.            FCol := black;
  163.            BCol := lightgray;
  164.            HiFCol := white;
  165.            HiBCol := black;
  166.            LoFCol := lightgray;
  167.            LoBCol := black;
  168.            PFCol := white;
  169.            PBCol := black;
  170.            BoxFCol := white;
  171.            BoxBCol := black;
  172.            Msg_FCol := white;
  173.            Msg_BCol := black;
  174.            Msg_Line := 0;
  175.        end
  176.        else
  177.        begin
  178.            FCol := black;
  179.            BCol := lightgray;
  180.            HiFCol := black;
  181.            HiBCol := lightgray;
  182.            LoFCol := lightgray;
  183.            LoBCol := black;
  184.            PFCol := white;
  185.            PBCol := black;
  186.            BoxFCol := white;
  187.            BoxBCol := black;
  188.            Msg_FCol := lightred;
  189.            Msg_BCol := black;
  190.            Msg_Line := 0;
  191.        end;
  192.    end;
  193. end;
  194.  
  195. Procedure Clang;
  196. begin
  197.     If RTTT.Beep then
  198.     begin
  199.         sound(500);
  200.         delay(50);
  201.         nosound;
  202.     end;
  203. end;
  204.  
  205. Procedure Read_Line(X,Y,L,F,B,Format:byte;
  206.                      var Text   :string);
  207. {
  208. X is X coord of first character in field
  209. Y is Y coord of field
  210. L is the maximum length of the input field
  211. F is the foreground color
  212. B is the background color
  213. Fornat Codes:      1   Any String
  214.                    2   Force Upper String
  215.                    3   Yes/No
  216.                    4   Alphabetics only
  217.                    5   Integer
  218.                    6   LongInteger
  219.                    7   Real
  220.                    8   Word
  221.                    (*   Maybe
  222.                    9   Date    (MM/DD/YY)
  223.                    10  Date    (DD/MM/YY)
  224.                    *)
  225.                    11  Echo a Password
  226. Text is a string updated with the string equivalent of user input
  227. }
  228. var
  229.     TempText : string;
  230.     CursorPos : byte;
  231.     InsertMode,
  232.     Password,
  233.     Alldone : boolean;
  234.     FirstCharPress: boolean;
  235.     Ch : char;
  236.  
  237.     Procedure Check_Parameters;
  238.     begin
  239.         TempText := Text;
  240.         If length(TempText) > L then
  241.            Delete(Temptext,L+1,length(TempText)-L);
  242.         If not X in [1..80] then
  243.            X := 1;
  244.         If X + L - 1 > 80 then X := 81 - L;
  245.         If not Y in [1..25] then
  246.            Y := 1;
  247.         If RTTT.BegCursor then
  248.            CursorPos := 1
  249.         else
  250.         begin
  251.             If length(TempText) < L then
  252.                CursorPos := length(TempText) + 1
  253.             else
  254.                CursorPos := length(TempText);
  255.         end;
  256.         InsertMode  := RTTT.Insert;
  257.         Alldone := False;
  258.         If Format = 11 then
  259.         begin
  260.             Password := true;
  261.             Format := 1;
  262.         end
  263.         else
  264.            Password := false;
  265.     end;  {sub Proc Check_Parameters}
  266.  
  267.     Function FillWhiteSpace(Str:string):string;
  268.     var I : integer;
  269.     begin
  270.         If Password then
  271.            Str := replicate(length(Str),PassChar);
  272.         while length(Str) < L do
  273.               Str := Str + RTTT.WhiteSpace;
  274.         FillWhiteSpace := Str;
  275.     end; {sub Func FillWhiteSpace}
  276.  
  277.     Procedure MoveTheCursor;
  278.     begin
  279.         GotoXY(X+CursorPos-1,Y);
  280.     end;  {sub Proc MoveTheCursor}
  281.  
  282.     Procedure Write_String;
  283.     begin
  284.         Fastwrite(X,Y,attr(F,B),FillWhiteSpace(TempText));
  285.         MoveTheCursor;
  286.     end;
  287.  
  288.     Procedure Erase_Field;
  289.     begin
  290.         TempText := '';
  291.         CursorPos := 1;
  292.         Write_String;
  293.     end;
  294.  
  295.     Procedure Char_Backspace;
  296.     begin
  297.         If CursorPos > 1 then
  298.         begin
  299.             CursorPos := Pred(CursorPos);
  300.             Delete(TempText,CursorPos,1);
  301.             Write_String;
  302.        end;
  303.     end;   {sub Proc Char_Backspace}
  304.  
  305.     Procedure Char_Del;
  306.     begin
  307.         If CursorPos <= length(TempText) then
  308.         begin
  309.             Delete(TempText,CursorPos,1);
  310.             Write_String;
  311.         end;
  312.     end;   {sub Proc Char_Del}
  313.  
  314.     Procedure Add_Char(Ch:char);
  315.     begin
  316.         If InsertMode then
  317.         begin
  318.             If length(TempText) < L then
  319.             begin
  320.                 Insert(Ch,TempText,CursorPos);
  321.                 If CursorPos < L then
  322.                    CursorPos := Succ(CursorPos);
  323.            end;
  324.         end
  325.         else {not insertmode}
  326.         begin
  327.             Delete(TempText,CursorPos,1);
  328.             Insert(Ch,TempText,CursorPos);
  329.             If CursorPos < L then
  330.                CursorPos := Succ(CursorPos);
  331.         end;   {if insert}
  332.         Write_String;
  333.     end;   {sub proc Add_Char}
  334.  
  335.  
  336. begin                  {main Procedure Read_Line}
  337.     Check_Parameters;
  338.     R_Null := false;
  339.     FindCursor(Cursor_X,Cursor_Y,ScanTop,ScanBot);
  340.     If RTTT.Insert then
  341.        HalfCursor
  342.     else
  343.        OnCursor;
  344.     Write_String;
  345.     FirstCharPress := true;
  346.     Repeat
  347.          Ch := Getkey;
  348.          If Format in [2,3] then
  349.             Ch := upcase(Ch);
  350.          If Ch in RTTT.End_Chars then
  351.          begin
  352.             AllDone := True;
  353.             If Ch <> #027 then Text := TempText;
  354.          end
  355.          else
  356.          Case Ch of
  357.          #131,              {mouseright}
  358.          CursorRight   :  begin
  359.                               If (CursorPos < L)
  360.                               and (CursorPos <= length(TempText)) then
  361.                               begin
  362.                                   CursorPos := Succ(CursorPos);
  363.                                   MoveTheCursor;
  364.                               end;
  365.                           end;
  366.          #130,               {mouseleft}
  367.          CursorLeft    :  begin
  368.                               If CursorPos > 1 then
  369.                               begin
  370.                                   CursorPos := Pred(CursorPos);
  371.                                   MoveTheCursor;
  372.                               end;
  373.                           end;
  374.          HomeKey       :  begin
  375.                               CursorPos := 1;
  376.                               MoveTheCursor;
  377.                           end;
  378.          EndKey        :  begin
  379.                               If CursorPos < L then
  380.                               If length(TempText) < L then
  381.                                   CursorPos := length(TempText) + 1
  382.                               else
  383.                                   CursorPos := L;
  384.                               MoveTheCursor;
  385.                           end;
  386.         InsKey        :  If Format <> 3 then   {don't allow insert on Y/N!}
  387.                          begin
  388.                              InsertMode := not InsertMode;
  389.                              If InsertMode then
  390.                                 HalfCursor
  391.                              else
  392.                                 OnCursor;
  393.                          end;
  394.         DelKey        :  Char_Del;
  395.         BackSpace     :  Char_Backspace;
  396.         Zap           :  Erase_Field;
  397.         #132,
  398.         EscKey        :  If RTTT.AllowEsc then
  399.                              Alldone := true
  400.                          else
  401.                             Clang;
  402.         #133,
  403.         EnterKey      :  begin
  404.                              Alldone := true;
  405.                              Text := TempText;
  406.                          end;
  407.        #33 .. #42,                                 {! to *}
  408.        #44,#47,                                    {, /}
  409.        #58 .. #64,                                 {: to @}
  410.        #91 .. #96,                                 {[ to '}
  411.        #123 .. #126   :  If (Format in [1,2]) then {{ to ~}
  412.                          begin
  413.                              If FirstCharPress and RTTT.EraseDefault then
  414.                                 Erase_Field;
  415.                              Add_Char(Ch);
  416.                          end
  417.                          else
  418.                              Clang;
  419.        #43, #45       : If (Format in [1,2])       { + - }
  420.                         or ( (CursorPos=1) and (Format in [5,6,7])) then
  421.                         begin
  422.                             If FirstCharPress and RTTT.EraseDefault then
  423.                                 Erase_Field;
  424.                             Add_Char(Ch);
  425.                         end
  426.                         else
  427.                            Clang;
  428.        #46            : If (Format in [1,2])       {.}
  429.                         or ( (Pos('.',TempText)=0) and (Format = 7)) then
  430.                         begin
  431.                             If FirstCharPress and RTTT.EraseDefault then
  432.                                 Erase_Field;
  433.                             Add_Char(Ch);
  434.                         end
  435.                         else
  436.                            Clang;
  437.        #48..#57       : If (Format in [1..2,5..8]) then {0 to 9}
  438.                         begin
  439.                             If FirstCharPress and RTTT.EraseDefault then
  440.                                 Erase_Field;
  441.                             Add_Char(Ch);
  442.                         end
  443.                         else
  444.                            Clang;
  445.        #32,                                              {space}
  446.        #65..#77,                                         {A to M}
  447.        #79..#88,                                         {O to X}
  448.        #90,                                              {Z}
  449.        #97..#122      : If (Format in [1,2,4]) then      {a to z}
  450.                         begin
  451.                             If FirstCharPress and RTTT.EraseDefault then
  452.                                 Erase_Field;
  453.                             Add_Char(Ch);
  454.                         end
  455.                         else
  456.                            Clang;
  457.        #78,#89        : If (Format in [1..4]) then        {N Y}
  458.                         begin
  459.                             Add_Char(Ch);
  460.                             If Format = 3 then
  461.                             begin
  462.                                 Alldone := true;
  463.                                 Text := TempText;
  464.                             end;
  465.                         end
  466.                         else
  467.                            Clang;
  468.       #128,#129       :;    {absorb stray mouse movement to avoid Clang'n}
  469.       else Clang;
  470.       end; {case}
  471.       FirstCharPress := false;
  472.       Until Alldone;
  473.       R_Char := Ch;
  474.       If  RTTT.RightJustify
  475.       and (Format > 4) then
  476.       begin
  477.           Fastwrite(X,Y,attr(F,B),replicate(L,RTTT.Whitespace));
  478.           Fastwrite(X+L-Length(TempText),Y,attr(F,B),Text);
  479.       end
  480.       else
  481.         Fastwrite(X,Y,attr(F,B),FillWhiteSpace(Text));
  482.       GotoXY(Cursor_X,Cursor_Y);
  483.       SizeCursor(ScanTop,ScanBot);
  484. end;  {Proc Read_Line}
  485.  
  486. Procedure Display_Box_and_Prompt(var X1,Y: byte;
  487.                                  BoxType:byte;
  488.                                  Prompt: StrScreen;
  489.                                  L:byte);
  490. {ensures that the input will fit on the screen, then draws box and prompt}
  491. const
  492.    Upchar = '^';
  493.    DnChar = '_';
  494. var
  495.   P,
  496.   width:byte;
  497.   InBorder : byte;    {is title in box border - 0 no, 1 upper, 2 lower}
  498. begin
  499.     If not ( (Y-ord(BoxType > 0)) in [1..DisplayLines] ) then
  500.        Y := 2;
  501.     If (X1 < 1) then
  502.        X1 := 2;
  503.     P := length(Prompt);
  504.     If (P > 1) and (Boxtype > 0) then    {check and see if prompt is in box}
  505.     begin
  506.        If Prompt[1] = Upchar then
  507.        begin
  508.            delete(Prompt,1,1);
  509.            dec(P);
  510.            InBorder := 1;
  511.        end
  512.        else
  513.           If Prompt[1] = DnChar then
  514.           begin
  515.               delete(Prompt,1,1);
  516.               dec(P);
  517.               InBorder := 2;
  518.           end
  519.           else
  520.              InBorder := 0;
  521.     end
  522.     else
  523.        InBorder := 0;
  524.     If InBorder > 0 then                      {determine dimensions of box}
  525.     begin
  526.         If P > L then
  527.            width := succ(P)
  528.         else
  529.            width := succ(L);
  530.     end
  531.     else
  532.        width := succ(P+l);
  533.     If pred(X1 + width) > 80 then
  534.        X1 :=  succ(80 - width);
  535.     If BoxType > 0 then         {draw the box}
  536.        FBox(X1,pred(Y),X1+width,succ(Y),RTTT.BoxFCol,RTTT.BoxBCol,BoxType);
  537.     If P > 0 then               {Draw the prompt}
  538.         Case InBorder of
  539.         0 : If BoxType> 0 then
  540.                Fastwrite(succ(X1),Y,attr(RTTT.PFcol,RTTT.PBCol),Prompt) {left Justified in upper border}
  541.             else
  542.                Fastwrite(X1,Y,attr(RTTT.PFcol,RTTT.PBCol),Prompt);
  543.         1 : FastWrite(succ(X1),pred(Y),attr(RTTT.PFcol,RTTT.PBCol),Prompt);
  544.         2 : FastWrite(X1+width-P,succ(Y),attr(RTTT.PFcol,RTTT.PBCol),Prompt);   {right justified in lower border}
  545.         end;
  546.     If InBorder > 0 then        {return var X1 adjusted to position of input field}
  547.     begin
  548.        If Boxtype > 0 then
  549.           X1 := succ(X1);
  550.     end
  551.     else
  552.     begin
  553.        If Boxtype > 0 then
  554.           X1 := succ(X1) + p
  555.        else
  556.           X1 := X1 + P;
  557.     end;
  558. end;
  559. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  560.  
  561.  Procedure ReadLine(X,Y,L,F,B:byte;var Text: string;var Retcode:integer);
  562.  {compatibility module with TTT 4.0}
  563.  begin
  564.      Read_Line(X,Y,L,F,B,1,Text);
  565.      If R_Char = #027 then
  566.         RetCode := 1         {5.00a}
  567.      else
  568.         Retcode := 0;        {5.00a}
  569.  end; {of proc ReadLine}
  570.  
  571.  
  572. Procedure Read_String(X,Y,L:byte;
  573.                       Prompt:StrScreen;
  574.                       BoxType: byte;
  575.                       Var Txt:StrScreen);
  576. begin
  577.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  578.     Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,1,Txt);
  579. end;
  580.  
  581. Procedure Read_String_Upper(X,Y,L:byte;
  582.                             Prompt:StrScreen;
  583.                             BoxType: byte;
  584.                             Var Txt:StrScreen);
  585. begin
  586.     Txt :=  Upper(Txt);
  587.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  588.     Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,2,Txt);
  589. end;
  590.  
  591. Procedure Read_Password(X,Y,L:byte;
  592.                         Prompt:StrScreen;
  593.                         BoxType: byte;
  594.                         Var Txt:StrScreen);
  595. begin
  596.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  597.     Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,11,Txt);
  598. end;
  599.  
  600. Procedure Read_Alpha(X,Y,L:byte;
  601.                      Prompt:StrScreen;
  602.                      BoxType: byte;
  603.                      Var Txt:StrScreen);
  604. begin
  605.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  606.     Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,4,Txt);
  607. end;
  608.  
  609. Procedure Read_YN(X,Y:byte;
  610.                   Prompt:StrScreen;
  611.                   BoxType: byte;
  612.                   Var Yes:Boolean);
  613.  
  614. var
  615.   Global_Insert : boolean;
  616.   Txt : StrScreen;
  617. begin
  618.     If Yes then
  619.        Txt := 'Y'
  620.     else
  621.        Txt := 'N';
  622.     Global_Insert := RTTT.insert;
  623.     RTTT.Insert := false;            {force to overwrite mode}
  624.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,1);
  625.     Read_Line(X,Y,1,RTTT.FCol,RTTT.BCol,3,Txt);
  626.     RTTT.Insert := Global_Insert;    {reset back}
  627.     If Txt = 'Y' then
  628.        Yes := true
  629.     else
  630.        Yes := false;
  631. end;
  632.  
  633. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  634.  
  635. Procedure Invalid_Message(Y : byte; var CH : char);
  636. begin
  637.    Clang;
  638.    TempMessageCH(1,Y,RTTT.Msg_Fcol,RTTT.Msg_BCol,
  639.                PadCenter('Invalid number - press any key to resume',80,' '),CH);
  640. end;
  641.  
  642. Procedure OutOfRange_Message(Y : byte;MinS,MaxS : StrScreen;var CH:char);
  643. var S : StrScreen;
  644. begin
  645.    Clang;
  646.    S := 'Error value must be in the range '+MinS+' to '+MaxS+' - press any key to resume';
  647.    TempMessageCh(1,Y,RTTT.Msg_Fcol,RTTT.Msg_BCol,PadCenter(S,80,' '),CH);
  648. end;
  649.  
  650. Function MessageLine(Y : byte):byte;
  651. begin
  652.     If (RTTT.Msg_Line = 0) or (RTTT.Msg_Line > DisplayLines) then
  653.     begin
  654.         If Y < DisplayLines then    {set message Line}
  655.            MessageLine := succ(Y)
  656.         else
  657.            MessageLine := pred(Y);
  658.     end
  659.     else
  660.        MessageLine := RTTT.Msg_Line;
  661. end;
  662.  
  663. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  664.  
  665. Procedure Read_Byte(X,Y,L:byte; 
  666.                     Prompt:StrScreen;
  667.                     BoxType: byte;
  668.                     Var B : byte; 
  669.                     Min, Max : byte);
  670. var
  671.    Temp : byte;
  672.    Txt : StrScreen;
  673.    Valid : boolean;
  674.    Code : integer;
  675.    YT : byte;
  676.    CHB : char;
  677. begin
  678.     If Max = 0 then
  679.       Max := 255;
  680.     If Min >= Max then
  681.        Min := 0;
  682.     If (B < Min) or (B > Max) then
  683.         B := Min;
  684.     If ((B = 0) and RTTT.SuppressZero) then
  685.        Txt := ''
  686.     else
  687.        Txt := Int_To_Str(B);
  688.     Temp := B;
  689.     Valid := false;
  690.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  691.     YT := MessageLine(Y);
  692.     Repeat
  693.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,8,Txt);
  694.          If ((R_Char = #027) and RTTT.AllowEsc)
  695.          or ((Txt = '') and (RTTT.AllowNull)) then
  696.          begin
  697.              If Txt = '' then R_Null := true;
  698.              exit;
  699.          end
  700.          else
  701.          begin
  702.              val(Txt,Temp,code);
  703.              If code <> 0 then
  704.              begin
  705.                 Invalid_Message(YT,CHB);
  706.                 If ChB = #027 then
  707.                         Txt := Int_To_Str(B);
  708.              end
  709.              else
  710.              begin
  711.                  If (Temp < Min) 
  712.                  or (Temp > Max) 
  713.                  or ((length(Txt) > 2) and (Txt > '255')) then
  714.                  begin
  715.                     OutOfRange_Message(Yt,Int_To_Str(Min),Int_To_Str(Max),CHB);
  716.                     If ChB = #027 then
  717.                         Txt := Int_To_Str(B);
  718.                  end
  719.                  else
  720.                  begin
  721.                      B := temp;
  722.                      Valid := true;
  723.                  end;
  724.              end;
  725.          end;
  726.     Until Valid or ((R_Char = #027) and RTTT.AllowEsc);
  727. end;
  728.  
  729. Procedure Read_Word(X,Y,L:byte; 
  730.                     Prompt:StrScreen;
  731.                     BoxType: byte;
  732.                     Var W : word; 
  733.                     Min, Max : word);
  734. var
  735.    Temp : word;
  736.    Txt : StrScreen;
  737.    Valid : boolean;
  738.    Code : integer;
  739.    YT : byte;
  740.    ChW : char;
  741. begin
  742.     If Max = 0 then
  743.       Max := MaxWord;
  744.     If Min >= Max then
  745.        Min := MinWord;
  746.     If (W < Min) or (W > Max) then
  747.         W := Min;
  748.     If ((W = 0) and RTTT.SuppressZero) then
  749.        Txt := ''
  750.     else
  751.        Txt := Int_To_Str(W);
  752.     Temp := W;
  753.     Valid := false;
  754.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  755.     YT := MessageLine(Y);
  756.     Repeat
  757.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,8,Txt);
  758.          If ((R_Char = #027) and RTTT.AllowEsc)
  759.          or ((Txt = '') and (RTTT.AllowNull)) then
  760.          begin
  761.              If Txt = '' then R_Null := true;
  762.              exit;
  763.          end
  764.          else
  765.          begin
  766.              val(Txt,Temp,code);
  767.              If code <> 0 then
  768.              begin
  769.                 Invalid_Message(YT,ChW);
  770.                 If ChW = #027 then
  771.                         Txt := Int_To_Str(W);
  772.              end
  773.              else
  774.              begin
  775.                  If (Temp < Min) 
  776.                  or (Temp > Max) 
  777.                  or ((length(Txt) > 4) and (Txt > Int_To_Str(MaxWord))) then
  778.                  begin
  779.                     OutOfRange_Message(Yt,Int_To_Str(Min),Int_To_Str(Max),ChW);
  780.                     If ChW = #027 then
  781.                         Txt := Int_To_Str(W);
  782.                  end
  783.                  else
  784.                  begin
  785.                      W := temp;
  786.                      Valid := true;
  787.                  end;
  788.              end;
  789.          end;
  790.     Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
  791. end;
  792.  
  793.  
  794. Procedure Read_Int(X,Y,L:byte;
  795.                    Prompt:StrScreen;
  796.                    BoxType: byte;
  797.                    Var W : integer;
  798.                    Min, Max : integer);
  799. var
  800.    Temp : integer;
  801.    Txt : StrScreen;
  802.    Valid : boolean;
  803.    Code : integer;
  804.    YT : byte;
  805.    ChI : char;
  806. begin
  807.     If Max = 0 then
  808.       Max := MaxInt;
  809.     If Min >= Max then
  810.        Min := MinInt;
  811.     If (W < Min) or (W > Max) then
  812.         W := Min;
  813.     If ((W = 0) and RTTT.SuppressZero) then
  814.        Txt := ''
  815.     else
  816.        Txt := Int_To_Str(W);
  817.     Temp := W;
  818.     Valid := false;
  819.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  820.     YT := MessageLine(Y);
  821.     Repeat
  822.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,5,Txt);
  823.          If ((R_Char = #027) and RTTT.AllowEsc)
  824.          or ((Txt = '') and (RTTT.AllowNull)) then
  825.          begin
  826.              If Txt = '' then R_Null := true;
  827.              exit;
  828.          end
  829.          else
  830.          begin
  831.              val(Txt,Temp,code);
  832.              If code <> 0 then
  833.              begin
  834.                 Invalid_Message(YT,ChI);
  835.                 If ChI = #027 then
  836.                    Txt := Int_to_Str(W);
  837.  
  838.              end
  839.              else
  840.              begin
  841.                  If (Temp < Min) or (Temp > Max) then
  842.                  begin
  843.                     OutOfRange_Message(Yt,Int_To_Str(Min),Int_To_Str(Max),ChI);
  844.                     If ChI = #027 then
  845.                        Txt := Int_to_Str(W);
  846.                  end
  847.                  else
  848.                  begin
  849.                      W := temp;
  850.                      Valid := true;
  851.                  end;
  852.             end;
  853.         end;
  854.     Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
  855. end;
  856.  
  857. Procedure Read_LongInt(X,Y,L:byte;
  858.                    Prompt:StrScreen;
  859.                    BoxType: byte;
  860.                    Var W : longint;
  861.                    Min, Max : longint);
  862. var
  863.    Temp : longint;
  864.    Txt : StrScreen;
  865.    Valid : boolean;
  866.    Code : integer;
  867.    YT : byte;
  868.    ChI : char;
  869. begin
  870.     If Max = 0 then
  871.       Max := MaxLongInt;
  872.     If Min >= Max then
  873.        Min := MinLongInt;
  874.     If (W < Min) or (W > Max) then
  875.         W := Min;
  876.     If ((W = 0) and RTTT.SuppressZero) then
  877.        Txt := ''
  878.     else
  879.        Txt := Int_To_Str(W);
  880.     Temp := W;
  881.     Valid := false;
  882.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);
  883.     YT := MessageLine(Y);
  884.     Repeat
  885.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,5,Txt);
  886.          If ((R_Char = #027) and RTTT.AllowEsc)
  887.          or ((Txt = '') and (RTTT.AllowNull)) then
  888.          begin
  889.              If Txt = '' then R_Null := true;
  890.              exit;
  891.          end
  892.          else
  893.          begin
  894.              val(Txt,Temp,code);
  895.              If code <> 0 then
  896.              begin
  897.                 Invalid_Message(YT,ChI);
  898.                 If ChI = #027 then
  899.                    Txt := Int_to_Str(W);
  900.              end
  901.              else
  902.              begin
  903.                  If (Temp < Min) or (Temp > Max) then
  904.                  begin
  905.                     OutOfRange_Message(Yt,Int_To_Str(Min),Int_To_Str(Max),ChI);
  906.                     If ChI = #027 then
  907.                        Txt := Int_to_Str(W);
  908.                  end
  909.                  else
  910.                  begin
  911.                      W := temp;
  912.                      Valid := true;
  913.                  end;
  914.             end;
  915.         end;
  916.     Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
  917. end;
  918.  
  919. Procedure Read_Real(X,Y,L:byte;
  920.                     Prompt:StrScreen;
  921.                     BoxType: byte;
  922.                     Var W : real; 
  923.                     Min, Max : real);
  924. var
  925.    Temp : Real;
  926.    Txt : StrScreen;
  927.    Valid : boolean;
  928.    Code : integer;
  929.    YT : byte;
  930.    ChR : char;
  931. begin
  932.     If Max = 0 then
  933.       Max := 99999999;
  934.     If Min >= Max then
  935.        Min := -99999999;
  936.     If (W < Min) or (W > Max) then
  937.         W := Min;
  938.     If Min < 0 then    {add room for - sign}
  939.        Inc(L);
  940.     If ((W = 0.0) and RTTT.SuppressZero) then
  941.        Txt := ''
  942.     else
  943.        Txt := Real_To_Str(W,RTTT.RealDP);
  944.     Temp := W;
  945.     Valid := false;
  946.     Display_Box_and_Prompt(X,Y,Boxtype,Prompt,L);      {5.00b}
  947.     YT := MessageLine(Y);
  948.     Repeat
  949.          Read_Line(X,Y,L,RTTT.FCol,RTTT.BCol,7,Txt);
  950.          If ((R_Char = #027) and RTTT.AllowEsc)
  951.          or ((Txt = '') and (RTTT.AllowNull)) then
  952.          begin
  953.              If Txt = '' then R_Null := true;
  954.              exit;
  955.          end
  956.          else
  957.          begin
  958.              val(Txt,Temp,code);
  959.              If code <> 0 then
  960.              begin
  961.                 Invalid_Message(YT,ChR);
  962.                 If ChR = #027 then
  963.                    Txt := Real_to_Str(W,RTTT.RealDP);
  964.              end
  965.              else
  966.              begin
  967.                  If (Temp < Min) or (Temp > Max) then
  968.                  begin
  969.                     OutOfRange_Message(Yt,Real_To_Str(Min,RTTT.RealDP),Real_To_Str(Max,RTTT.RealDP),ChR);
  970.                     If ChR = #027 then
  971.                        Txt := Real_to_Str(W,RTTT.RealDP);
  972.                  end
  973.                  else
  974.                  begin
  975.                      W := temp;
  976.                      Valid := true;
  977.                  end;
  978.             end;
  979.         end;
  980.     Until Valid  or ((R_Char = #027) and RTTT.AllowEsc);
  981. end;
  982.   
  983. Procedure Read_Select(X,Y:byte;Pmt,Txt:StrScreen;var Choice:byte);
  984. Const
  985.      UpChar:string[1] = '^';
  986.      JoinChar:string[1] = '_';
  987. var
  988.   W : byte;
  989.   I : integer;
  990.   Horiz : boolean;
  991.      Function Replace_JoinChar(Str:string): string;
  992.      {}
  993.      var I : integer;
  994.      begin
  995.          For I := 1 to length(Str) do
  996.              If Str[I] = JoinChar then
  997.                 Str[I] := ' ';
  998.          Replace_JoinChar := Str;
  999.      end; {of func Replace_JoinChar}
  1000.  
  1001.      Procedure HiLightWord(W:byte;Hi:boolean);
  1002.      var Col : byte;
  1003.      begin
  1004.          If Hi then
  1005.             Col := attr(RTTT.HiFCol,RTTT.HiBcol)
  1006.          else
  1007.             Col := attr(RTTT.LoFcol,RTTT.LoBcol);
  1008.          If Horiz then
  1009.              Fastwrite(pred(X)+PosWord(W,Txt),Y,Col,Replace_JoinChar(ExtractWords(W,1,Txt)))
  1010.          else
  1011.              Fastwrite(X,pred(Y)+W,Col,Replace_JoinChar(ExtractWords(W,1,Txt)));
  1012.          If Hi then
  1013.          begin
  1014.             If Horiz then
  1015.                GotoXY(pred(X)+PosWord(W,Txt),Y)
  1016.             else
  1017.                GotoXY(X,Pred(Y)+W);
  1018.          end;
  1019.      end;
  1020.  
  1021.      Procedure Process_Keys;
  1022.      var
  1023.        ChP : char;
  1024.        Finished : boolean;
  1025.      begin
  1026.          Finished := false;
  1027.          Repeat
  1028.               ChP := getKey;
  1029.               If ChP in RTTT.End_Chars then
  1030.                   Finished := True
  1031.               else
  1032.               Case upcase(ChP) of
  1033.               #132,
  1034.               EscKey      : If RTTT.AllowEsc then
  1035.                                 Finished := true;
  1036.               ' ',#9,                                 {tab}
  1037.               CursorDown,
  1038.               CursorRight : begin
  1039.                                 HiLightWord(Choice,false);
  1040.                                 If Choice < W then
  1041.                                    Inc(Choice)
  1042.                                 else
  1043.                                    Choice := 1;
  1044.                                 HiLightWord(Choice,true);
  1045.                             end;
  1046.               #143,                     {Shift tab}
  1047.               CursorUp,
  1048.               CursorLeft  : begin
  1049.                                 HiLightWord(Choice,false);
  1050.                                 If Choice > 1 then
  1051.                                    Dec(Choice)
  1052.                                 else
  1053.                                    Choice := W;
  1054.                                 HiLightWord(Choice,true);
  1055.                             end;
  1056.               #131        : If (Choice < W) and Horiz then    {mouse right}
  1057.                             begin
  1058.                                 HiLightWord(Choice,false);
  1059.                                 Inc(Choice);
  1060.                                 HiLightWord(Choice,true);
  1061.                             end;
  1062.               #130        : If (Choice > 1) and Horiz then    {mouse left}
  1063.                             begin
  1064.                                 HiLightWord(Choice,false);
  1065.                                 Dec(Choice);
  1066.                                 HiLightWord(Choice,true);
  1067.                             end;
  1068.               #129        : If (Choice < W) and (Horiz = false) then    {mouse down}
  1069.                             begin
  1070.                                 HiLightWord(Choice,false);
  1071.                                 Inc(Choice);
  1072.                                 HiLightWord(Choice,true);
  1073.                             end;
  1074.               #128        : If (Choice > 1) and (Horiz = false) then    {mouse up}
  1075.                             begin
  1076.                                 HiLightWord(Choice,false);
  1077.                                 Dec(Choice);
  1078.                                 HiLightWord(Choice,true);
  1079.                             end;
  1080.  
  1081.               end; {case}
  1082.          until Finished;
  1083.          R_Char := ChP;
  1084.      end;
  1085.  
  1086. begin
  1087.     If Txt[1] = UpChar then
  1088.     begin
  1089.         Horiz := False;
  1090.         Delete(Txt,1,1);
  1091.     end
  1092.     else
  1093.        Horiz := true;
  1094.     W := Wordcnt(Txt);
  1095.     If W < 2 then exit;              {only show choices if there are two or more}
  1096.     FindCursor(Cursor_X,Cursor_Y,ScanTop,ScanBot);   {record cursor settings}
  1097.     If (Choice > W) or (Choice < 1) then               {check that W is sensible}
  1098.        Choice := 1;
  1099.     If Pmt <> '' then
  1100.     begin
  1101.         Fastwrite(X,Y,attr(RTTT.PFcol,RTTT.PBCol),Pmt);
  1102.         X := X+length(Pmt);
  1103.     end;
  1104.     For I := 1 to W do
  1105.         HiLightWord(I,False);
  1106.     OnCursor;
  1107.     HiLightWord(Choice,True);
  1108.     Process_keys;
  1109.     GotoXY(Cursor_X,Cursor_Y);           {reset cursor}
  1110.     SizeCursor(ScanTop,ScanBot);
  1111. end;  {proc Read_Select}
  1112.  
  1113. begin
  1114.    Default_Settings;
  1115. end.
  1116.